(DEFPROP %DEFIN
	 (LAMBDA (X V F P)
		 (PROG (R)
		       (SETQ R (COND ((GETL X
					    (QUOTE (EXPR FEXPR
							 SUBR
							 FSUBR
							 LSUBR
							 MACRO)))
				      (LIST X (QUOTE REDEFINED)))
				     (T X)))
		       (PUTPROP X (LIST (QUOTE LAMBDA) V F) P)
		       (RETURN R)))
	 EXPR)

(DEFPROP DE
 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE EXPR)))
 FEXPR)

(DEFPROP DF
 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE FEXPR)))
 FEXPR)

(DEFPROP DM
 (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE MACRO)))
 FEXPR)

(DEFPROP PLUS (LAMBDA (L) (*EXPAND L (QUOTE *PLUS))) MACRO)

(DEFPROP DIFFERENCE (LAMBDA (L) (*EXPAND L (QUOTE *DIF))) MACRO)

(DEFPROP TIMES (LAMBDA (L) (*EXPAND L (QUOTE *TIMES))) MACRO)

(DEFPROP QUOTIENT (LAMBDA (L) (*EXPAND L (QUOTE *QUO))) MACRO)

(DEFPROP LESSP
 (LAMBDA (L)
  (LIST	(QUOTE *LESS)
	(*EXPAND1 (CDR (REVERSE (CDR L)))
		  (QUOTE (LAMBDA (X Y)
				 (COND ((AND X (*LESS X Y)) Y)))))
	(CAR (LAST L))))
 MACRO)


(DEFPROP GREATERP
 (LAMBDA (L)
  (LIST	(QUOTE *GREAT)
	(*EXPAND1 (CDR (REVERSE (CDR L)))
		  (QUOTE (LAMBDA (X Y)
				 (COND ((AND X (*GREAT X Y)) Y)))))
	(CAR (LAST L))))
 MACRO)

(DEFPROP %DEVP
	 (LAMBDA (X)
		 (OR (EQ (CAR (LAST (EXPLODE X))) (QUOTE :))
		     (AND (NOT (ATOM X)) (NOT (ATOM (CDR X))))))
	 EXPR)

(DE %READCHAN (%CHAN %TALK)
	      (PROG (%OLDCHAN %SEXPR)
		    (SETQ %OLDCHAN (INC %CHAN NIL))
	       LOOP (SETQ %SEXPR (ERRSET (READ)))
		    (COND ((EQ (CAR %SEXPR) (QUOTE COMMENT))
			   (PROG (%XCH)
				A
				(SETQ %XCH (READCH))
				(AND (EQ %XCH (QUOTE /;))
				     (RETURN))
				(GO A) )
			   (GO LOOP)) )
		    (COND ((ATOM %SEXPR) (GO END)))
		    (SETQ %SEXPR (EVAL (CAR %SEXPR)))
		    (COND (%TALK (PRINT %SEXPR)))
		    (GO LOOP)
	       END  (INC %OLDCHAN T)
		    (RETURN NIL)))

(DE %READAFILE (%DEV %FNAM %TALK)
 (%READCHAN (EVAL (LIST (QUOTE INPUT) (GENSYM) %DEV %FNAM)) %TALK))

(DE READIN (%DEV %FLIST %TALK)
    (PROG NIL
     LOOP (COND	((NULL %FLIST) (RETURN (QUOTE FINISHED-LOADING)))
		((%DEVP (CAR %FLIST)) (SETQ %DEV (CAR %FLIST))
				      (SETQ %FLIST (CDR %FLIST))
				      (GO LOOP)))
	  (%READAFILE %DEV (CAR %FLIST) %TALK)
	  (SETQ %FLIST (CDR %FLIST))
	  (GO LOOP)))

(DF DSKIN (%L) (READIN (QUOTE DSK:) %L T))

(DF SYSIN (%L) (READIN (QUOTE SYS:) %L NIL))

(DEFPROP PUTSYM
 (LAMBDA (L)
  (MAPCAR (FUNCTION (LAMBDA (X)
		     (COND ((ATOM X) (*PUTSYM X X))
			   (T (*PUTSYM (CAR X) (EVAL (CADR X)))))))
	  L))
 FEXPR)


(DEFPROP GETSYM
 (LAMBDA (L)
  (MAPCAR
   (FUNCTION (LAMBDA (X)
	      (PROG (V)
		    (SETQ V (*GETSYM X))
		    (COND (V (PUTPROP X (NUMVAL V) (CAR L)))
			  (T (PRINT (CONS X
					  (QUOTE (NOT IN
						      SYMBOL
						      TABLE))))))
		    (RETURN V))))
   (CDR L)))
 FEXPR)

(DF BREAK (%LL%)
	  (PROG (%EX% %ICH% %OCH%)
		(SETQ %ICH% (INC NIL NIL))
		(SETQ %OCH% (OUTC NIL NIL))
		(PRINT (CONS (QUOTE *BREAK*) (CAR %LL%)))
	   LOOP	(TERPRI)
		(SETQ %EX% (ERRSET (READ)))
		(COND ((ATOM %EX%) (GO LOOP)))
		(COND ((EQ (CAR %EX%) *BPROCEED*) (GO END)))
		(ERRSET (PRIN1 (EVAL (CAR %EX%))))
		(GO LOOP)
	   END	(INC %ICH% NIL)
		(OUTC %OCH% NIL)
		(RETURN (EVAL (CADR %LL%)))))

(SETQ *BPROCEED* (QUOTE P))

(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN LAP)
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (DEFSYM LAP OPS))))

(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN (SOSLNK.LAP))
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (EDFUN FILEIN))))


(PROG (EX)
      (SETQ EX (QUOTE (LAMBDA (L)
		       (PROG2 (SYSIN TRACE)
			      (LIST (QUOTE QUOTE) (EVAL L))))))
      (MAPC (FUNCTION (LAMBDA (X) (PUTPROP X EX (QUOTE MACRO))))
	    (QUOTE (TRACE UNTRACE
			  TRACET
			  UNTRACET
			  SLST
			  UNSLST
			  RESET))))

(DF COMMENT (L) NIL)

(DF DECLARE (L) NIL)

(SETQ EIGHT (ADD1 7))

(SETQ TEN (PLUS 2 EIGHT))

(DE OCTAL NIL (SETQ BASE (SETQ IBASE EIGHT)))

(DE DECIMAL NIL (SETQ BASE (SETQ IBASE TEN)))

(COND ((NULL (ERRSET (INPUT INITCHAN DSK: (LISP . INI)) NIL)))
      (T (%READCHAN (QUOTE INITCHAN) NIL)))

(PROG NIL (INC NIL T) (OUTC NIL T) (EXCISE) (CSYM G0000) (ERR))